ETO Development Tools 2/ETO Development Tools 2.iso/Tools - Objects/MacApp/MacApp CD Release/MacApp 2.0.1 (Many Libraries)/Libraries/UObject.TObject.p

Text File | 1990-10-25 | 8.1 KB | 370 lines | [TEXT/MPS ]

{$P}
{[a-,body+,h-,o=100,r+,rec+,t=4,u+,#+,j=20/57/1$,n-]}
{ UObject.TObject.p }
{ Copyright © 1984-1990 by Apple Computer, Inc.  All rights reserved. }
{$IFC UNDEFINED qMacApp}
{$SETC qMacApp := FALSE}
{$ENDC}

{$Push} {$IFC NOT qDebugTheDebugger}
{$W+}
{$R-}
{$Init-}
{$OV-}
{$ENDC}

{--------------------------------------------------------------------------------------------------}
{$S MAObjectRes}

FUNCTION TObject.Clone;

    BEGIN
    Clone := ShallowClone;
    END;

{--------------------------------------------------------------------------------------------------}
{$Push} {$IFC qTrace} {$D+} {$ENDC}
{$S MAFields}

PROCEDURE TObject.DynamicFields(PROCEDURE DoToField(fieldName: Str255;
                                                    fieldAddr: Ptr;
                                                    fieldType: integer));

    BEGIN
    { ??? Would a nicer default be a formatted memory dump? }
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$Push} {$IFC qTrace} {$D+} {$ENDC}
{$S MAFields}

PROCEDURE TObject.Fields(PROCEDURE DoToField(fieldName: Str255;
                                             fieldAddr: Ptr;
                                             fieldType: integer));

    CONST
        bObjClassID         = bInteger;

    VAR
        myID:                ObjClassID;
        mySize:             Size;

    BEGIN
    myID := GetClass;
    mySize := GetInstanceSize;
    DoToField('TObject', NIL, bClass);
    DoToField('ObjClassID', @myID, bObjClassID);
    DoToField('Size in bytes', @mySize, bLongint);

    DynamicFields(DoToField);                            { Get the dynamic part inspected }

    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$S MAObjectRes}

PROCEDURE TObject.ForAllSubClassesDo(PROCEDURE DoToSubClass(theClass: ObjClassID));

    BEGIN
    EachSubClassDo(GetClass, DoToSubClass);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAObjectRes}

PROCEDURE TObject.ForAllSuperClassesDo(PROCEDURE DoToSubClass(theClass: ObjClassID));

    BEGIN
    EachSuperClassDo(GetClass, DoToSubClass);
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAObjectRes}

PROCEDURE TObject.Free;

    BEGIN
    ShallowFree;
    END;

{--------------------------------------------------------------------------------------------------}
{$Push} {$IFC qTrace} {$D+} {$ENDC}
{$S MAObjectRes}

PROCEDURE TObject.GetClassName(VAR clName: MAName);

    BEGIN
    GetClassNameFromID(GetClass, clName);
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$Push} {$IFC qTrace} {$D+} {$ENDC}
{$S MAObjectRes}

FUNCTION TObject.GetClass: ObjClassID;

    BEGIN
    GetClass := GetClassID(self);
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$Push} {$IFC qTrace} {$D+} {$ENDC}
{$S MAObjectRes}

FUNCTION TObject.GetClassSize: Size;

    BEGIN
    GetClassSize := GetClassSizeFromID(GetClass);
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$Push} {$IFC qTrace} {$D+} {$ENDC}
{$S MAObjectRes}

FUNCTION TObject.GetDynamicPtr: Ptr;
    VAR
        classSize: Size;

    BEGIN
    classSize := GetClassSize;

    if (GetHandleSize(Handle(self)) - classSize) > 0 THEN
        GetDynamicPtr := Ptr(striplong(Handle(self)^) + classSize)
    ELSE
        GetDynamicPtr := NIL;
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$Push} {$IFC qTrace} {$D+} {$ENDC}
{$S MAInspector}

PROCEDURE TObject.GetInspectorName(VAR inspectorName: Str255);

    BEGIN
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$Push} {$IFC qTrace} {$D+} {$ENDC}
{$S MAObjectRes}

FUNCTION TObject.GetDynamicSize: Size;

    BEGIN
    GetDynamicSize := GetHandleSize(Handle(self)) - GetClassSize;
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$Push} {$IFC qTrace} {$D+} {$ENDC}
{$S MAObjectRes}

FUNCTION TObject.GetInstanceSize: Size;

    BEGIN
    GetInstanceSize := GetHandleSize(Handle(self));
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$Push} {$IFC qTrace} {$D+} {$ENDC}
{$S MAObjectRes}

FUNCTION TObject.GetSuperClass: ObjClassID;

    BEGIN
    GetSuperClass := GetSuperClassID(GetClass);
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$S MAObjectRes}

PROCEDURE TObject.Initialize;

    BEGIN
    END;

{--------------------------------------------------------------------------------------------------}
{$Push} {$IFC qTrace} {$D+} {$ENDC}
{$S MADebug}

PROCEDURE TObject.Inspect;

    VAR
        clName:             MAName;

    BEGIN
    GetClassName(clName);
    Write(clName, '     ');
    WritePtr(self);
    WriteLn;
    pInspectLinePos := 0;
    Fields(InspectField);
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$S MAObjectRes}

PROCEDURE TObject.IObject;

    BEGIN
    Initialize;
    END;

{--------------------------------------------------------------------------------------------------}
{$Push} {$IFC qTrace} {$D+} {$ENDC}
{$S MAObjectRes}

FUNCTION TObject.IsSameClass(testClass: ObjClassID): BOOLEAN;

    BEGIN
    IsSameClass := (GetClass = testClass);
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$Push} {$IFC qTrace} {$D+} {$ENDC}
{$S MAObjectRes}

FUNCTION TObject.IsMemberClass(testClass: ObjClassID): BOOLEAN;

    BEGIN
    IsMemberClass := IsClassIDMemberClass(GetClass, testClass);
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$Push} {$IFC qTrace} {$D+} {$ENDC}
{$W+}
{$R-}
{$OV-}
{$S MAObjectRes}

FUNCTION TObject.Lock(lockIt: BOOLEAN): BOOLEAN;

    VAR
        wasLocked:            BOOLEAN;

    BEGIN
    wasLocked := IsHandleLocked(self);
    Lock := wasLocked;
    IF wasLocked <> lockIt THEN
        IF lockIt THEN
            HLock(Handle(self))
        ELSE
            HUnLock(Handle(self))
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$Push} {$IFC qTrace} {$D+} {$ENDC}
{$S MAObjectRes}

PROCEDURE TObject.SetInstanceSize(newSize: Size);

    BEGIN
    {$IFC qDebug}
    IF newSize < GetClassSize THEN
        ProgramBreak(
                   'In TObject.SetInstanceSize… trying to set instance size less than class minimum'
                     );
    {$Endc}
    IF qMacApp & pAllocateObjectsFromPerm THEN
        SetPermHandleSize(Handle(self), newSize)
    ELSE
        SetHandleSize(Handle(self), newSize);
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$Push} {$IFC qTrace} {$D+} {$ENDC}
{$S MAObjectRes}

PROCEDURE TObject.SetDynamicSize(newSize: Size);

    BEGIN
    IF qMacApp & pAllocateObjectsFromPerm THEN
        SetPermHandleSize(Handle(self), newSize + GetClassSize)
    ELSE
        SetHandleSize(Handle(self), newSize + GetClassSize);
    END;
{$Pop}

{--------------------------------------------------------------------------------------------------}
{$S MAObjectRes}

FUNCTION TObject.ShallowClone: TObject;

    VAR
        result:             TObject;
        oldPerm:            BOOLEAN;
        err:                OSErr;

        {$IFC qDebug}
        s:                    MAName;
        {$ENDC}

    BEGIN
    {$IFC qDebug}
    IF gAskAboutAlloc THEN
        BEGIN
        GetCallersMethodName(s);

        IF s = 'TOBJECT.CLONE' THEN                     { report about caller of TObject.Clone,
                                                         instead }
            GetMethodName(LongIntPtr(GetCurStackFramePtr)^ + 4, s);

        Write('Within ', s, ': trying to clone a: ''');
        GetClassName(s);
        WriteLn(s, '''.');

        IF ReadYesNo('     Return NIL (Y or N) [N]? ') THEN
            BEGIN
            ShallowClone := NIL;
            EXIT(ShallowClone);
            END;
        END;
    {$ENDC}

    result := self;

    {$IFC qMacApp}
    oldPerm := PermAllocation(TRUE);
    {$ENDC}

    err := HandToHand(Handle(result));

    {$IFC qMacApp}
    oldPerm := PermAllocation(oldPerm);
    {$ENDC}

    IF err <> noErr THEN
        result := NIL
        {$IFC qInspector}
    ELSE IF pAddNewObjectsToInspector THEN
        AddObjectToInspector(result)
        {$ENDC}
                             ;

    ShallowClone := result;
    END;

{--------------------------------------------------------------------------------------------------}
{$S MAObjectRes}

PROCEDURE TObject.ShallowFree;

    BEGIN
    Dispose(self);
    END;

{$Pop}